home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 25 / 64er_Magazin_Sonderheft_25_19xx_Markt__Technik_de.d64 / floppy-bag 801 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  12KB  |  361 lines
  1. 100 rem********************************
  2. 102 rem*  diskhuellen mps 801         *
  3. 104 rem********************************
  4. 106 rem* ein programm zur herstellung *
  5. 108 rem*  neuer diskettentaschen und  *
  6. 110 rem*      aufklebe-etiketten      *
  7. 112 rem********************************
  8. 124 rem*       johann gubesch         *
  9. 126 rem*       hengteweg 12           *
  10. 128 rem*       4420 coesfeld          *
  11. 130 rem*       02541/81472            *
  12. 132 rem********************************
  13. 134 gosub 160
  14. 136 gosub 190
  15. 138 if y=1 then gosub 500:gosub 530:gosub 796
  16. 140 dim db$(144):ax$="                    " :dim na$(144):xy=0
  17. 142 gosub 254
  18. 144 if y=2 then gosub 344:gosub 428:gosub 500:gosub 578:gosub 796
  19. 146 if y=3 then gosub 344:gosub 428:gosub 500:gosub 578:xy=1
  20. 148 if y=3 then gosub 254:gosub 344
  21. 150 if y=3 then gosub 428:gosub 500:gosub 726:gosub 796
  22. 152 if y=4 then gosub 344:gosub 428:gosub 500:gosub 726:gosub 796
  23. 154 if y=5 then gosub 344:gosub 500:gosub 672:gosub 796
  24. 156 end
  25. 158 rem ---- modul rahmen -------------
  26. 160 poke53281,1:poke53280,1:printchr$(142)
  27. 162 print"[147]         **  floppy-bag 801  **         ";
  28. 164 print"       fuer mps 801 und kompatible      ";
  29. 166 print" von j.gubesch, coesfeld, februar 1987  [146]"
  30. 168 poke 646,0:print"[145]";
  31. 170 for a=1to16
  32. 172 print"[221]                                      [221]";
  33. 174 next
  34. 176 print"[171][192][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][178][192][192][178][192][192][192][192][192][192][179]";
  35. 178 print"[221]           [221]                [221]  [221]      [221]";
  36. 180 print"[171][192][192][192][192][192][192][192][192][192][192][192][177][178][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][177][192][178][177][192][192][192][192][192][192][179]";
  37. 182 print"[221]            [221]                 [221]       [221]";
  38. 184 print"[173][192][192][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][189][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145]"
  39. 186 return
  40. 188 rem ---- modul auswahlmenue -------
  41. 190 print:print
  42. 192 print "[145][145][145][145]                                [146]"
  43. 194 print     "[145]   waehlen sie bitte den ge -   "
  44. 196 print      "      wuenschten ausdruck       "
  45. 198 print     "[145]            [146]( 1-5 )             "
  46. 200 print      "                                "
  47. 202 print"[145][145]"
  48. 204 print"1[146]- tasche"
  49. 206 print"[145]2[146]- tasche mit aufgedrucktem di-"
  50. 208 print"   rectory + etikett"
  51. 210 print"[145]3[146]- tasche mit aufgedrucktem di-"
  52. 212 print"   rectory + directory fuer die "
  53. 214 print"[145]   rueckseite + 2 etiketten"
  54. 216 print"4[146]- directory + etikett"
  55. 218 print"[145]5[146]- etikett"
  56. 220 getan$:ifan$=""then 220
  57. 222 if an$="1" then y=1:gosub 238:goto 234
  58. 224 if an$="2" then y=2:gosub 238:goto 234
  59. 226 if an$="3" then y=3:gosub 238:goto 234
  60. 228 if an$="4" then y=4:gosub 238:goto 234
  61. 230 if an$="5" then y=5:gosub 238:goto 234
  62. 232 goto 220
  63. 234 return
  64. 236 rem ---- modul bedienerfeld frei --
  65. 238 print""
  66. 240 print""
  67. 242 for t= 1to 7
  68. 244 print"                                      "
  69. 246 print"[145]                                      "
  70. 248 next
  71. 250 print"                                      "
  72. 252 return
  73. 254 rem ---- modul directory lesen ----
  74. 256 print""     :aw$="                                "
  75. 258 print"";aw$
  76. 260 print"[145]";aw$
  77. 262 print"";aw$
  78. 264 print"[145]";aw$
  79. 266 print"";aw$
  80. 268 print"[145][145][145][145][145]  einen moment bitte -"
  81. 270 print""
  82. 272 print"[145]  ich lese das directory ein !"
  83. 274 if xy=1 then gosub 320:goto 256
  84. 276 i=0:gb=1:close 15:open 15,8,15:close 1:open 1,8,0,"$0"
  85. 278 input#15,t,k$,o,o:if t<>0 then print"[145][145][145]floppyfehler:[146]";
  86. 280 if t<>0 then print"  ";k$:print"[146]floppy ein - disk rein   "
  87. 282 if t<>0 then print "[145]        [146]taste druecken         "
  88. 284 if t<>0 then poke 198,0:wait 198,1:run 134
  89. 286 get#1,da$,de$
  90. 288 get#1,da$,de$:db$(i+1)="":get#1,da$,de$
  91. 290 c=0
  92. 292 if da$<>"" then c=asc(da$)
  93. 294 if de$<>"" then c=c+asc(de$)*256
  94. 296 fr$=mid$(str$(c),2)
  95. 298 get#1,de$:if de$="" then za=i:goto 316
  96. 300 if de$<>chr$(34) then 298
  97. 302 get#1,de$:if de$<>chr$(34) then db$(i)=db$(i)+de$:goto 302
  98. 304 get#1,de$:if de$=chr$(32) then 304
  99. 306 dc$=""
  100. 308 dc$=dc$+de$:get#1,de$:if de$<>"" then 308
  101. 310 if gb=1 then id$=left$(dc$,2):gb=0
  102. 312 db$(i)=left$(db$(i)+ax$,17)
  103. 314 i=i+1:goto 288
  104. 316 close 1:close 15
  105. 318 return
  106. 320 print""     :aw$="                                "
  107. 322 print"";aw$
  108. 324 print"[145]";aw$
  109. 326 print"";aw$
  110. 328 print"[145]";aw$
  111. 330 print"";aw$
  112. 332 print"[145][145][145][145][145]bitte diskette wenden "
  113. 334 print""
  114. 336 print"[145]           [146] taste         "
  115. 338 poke 198,0:wait 198,1:xy=0
  116. 340 return
  117. 342 rem ---- modul dateneingabe -------
  118. 344 print""     :aw$="                                "
  119. 346 print"";aw$
  120. 348 print"[145]";aw$
  121. 350 print"";aw$
  122. 352 print"[145]";aw$
  123. 354 print"";aw$
  124. 356 print"[145][145][145][145][145]  bitte geben sie folgende"
  125. 358 print" daten ein bzw. uebernehmen mit"
  126. 360 print"[145]          [146]return"
  127. 362 co$=" 64 ":mo$=" 64":fl$="1541":nr$="...."
  128. 364 poke19,1:input"datum      :[146] tt.mm.jjjj[157][157][157][157][157][157][157][157][157][157]";te$:poke19,0
  129. 366 te$=left$(te$,10)
  130. 368 he$=left$(db$(0),16)
  131. 370 print"[145]disk-name  :[146] ";he$:poke19,1:input"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";he$
  132. 372 poke19,0
  133. 374 he$=left$(he$,16)
  134. 376 print "disk-nummer:[146] ";nr$;:poke19,1:input"[157][157][157][157]";nr$
  135. 378 poke19,0
  136. 380 nr$=left$(nr$,4 )
  137. 382 print "[145]disk-id    :[146] ";id$;:poke19,1:input"[157][157]";id$
  138. 384 poke19,0
  139. 386 id$=left$(id$,2 )
  140. 388 print "floppy     :[146] ";fl$;:poke19,1:input"[157][157][157][157]";fl$
  141. 390 poke19,0
  142. 392 fl$=left$(fl$,4)
  143. 394 print "[145]commodore  :[146] ";co$;:poke19,1:input"[157][157][157][157]";co$
  144. 396 poke19,0
  145. 398 co$=left$(co$,4)
  146. 400 print "modus      :[146] ";mo$;:poke19,1:input"[157][157][157]";mo$
  147. 402 poke19,0
  148. 404 mo$=left$(mo$,3)
  149. 406 print "stimmen alle angaben ? (j/n)"
  150. 408 getan$:if an$="" then 408
  151. 410 if an$="j" then 418
  152. 412 if an$="n" then print:print"[145][145][145][145]                              "
  153. 414 ifan$="n" then  print"[145][145][145][145][145][145][145][145][145][145][145][145]";:goto 364
  154. 416 goto 408
  155. 418 print"";te$;"";he$;"";id$;"";nr$;"floppy  ";fl$;"";
  156. 420 print" commodore ";co$;"";mo$;"'"
  157. 422 gosub 238
  158. 424 return
  159. 426 rem ---- modul files bearbeiten ---
  160. 428 print""     :aw$="                                "
  161. 430 print"";aw$
  162. 432 print"[145]";aw$
  163. 434 print"";aw$
  164. 436 print"[145]";aw$
  165. 438 print"";aw$
  166. 440 print   "[145][145][145][145][145][145][145]f1- filename aendern"
  167. 442 print"f3- filename streichen"
  168. 444 print"[145]f5- filename uebernehmen"
  169. 446 print"f7- trennung einfuegen"
  170. 448 print"[145]                                "
  171. 450 x1=1:x=0:t=x
  172. 452 if za>39 then za = 39
  173. 454 for t=0 to za-2
  174. 456 print"";x;"  ";left$(db$(x+x1),17);"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][145][145][145][145]"
  175. 458 getan$:if an$="" then 458
  176. 460 if an$="[135]" then na$(x)=left$(db$(x+x1),17):goto 484
  177. 462 if an$="[134]" then x=x-1:x1=x1+1
  178. 464 if an$="[134]" and x<0 then x=-1
  179. 466 if an$="[134]" then 484
  180. 468 if an$="[133]" then print"neuer name:[146] .";:poke19,1
  181. 470 if an$="[133]" then input"[157]";na$(x):poke19,0:na$(x)=left$(na$(x)    ,17)
  182. 472 if an$="[133]" then print "[145][145]                                   "
  183. 474 if an$="[133]" then print"[145][145][145][145][145][145]";:goto 484
  184. 476 if an$="[136]" then na$(x)="================ "
  185. 478 if an$="[136]" then x1=x1-1:t=t-1
  186. 480 if an$="[136]" then goto 484
  187. 482 goto 458
  188. 484 x=x+1:if x=38 then t=za-2
  189. 486 next
  190. 488 print  " keine files mehr vorhanden"
  191. 490 for t=xto38:na$(t)="[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164] ":next
  192. 492 poke 198,0:wait 198,1
  193. 494 gosub 238
  194. 496 return
  195. 498 rem ---- modul druckvorbereitung --
  196. 500 print""     :aw$="                                "
  197. 502 print"";aw$
  198. 504 print"[145]";aw$
  199. 506 print"";aw$
  200. 508 print"[145]";aw$
  201. 510 print"";aw$
  202. 512 print"[145][145][145][145][145][145][145]drucker eingeschaltet und"
  203. 514 print"papier richtig eingespannt ?"
  204. 516 print"[145](j/n)"
  205. 518 getan$:if an$="" then 518
  206. 520 if an$="j" then 524
  207. 522 goto 518
  208. 524 gosub 238
  209. 526 return
  210. 528 rem ---- modul dr huelle ----------
  211. 530 print""     :aw$="                                "
  212. 532 print"";aw$
  213. 534 print"[145]";aw$
  214. 536 print"";aw$
  215. 538 print"[145]";aw$
  216. 540 print"";aw$
  217. 542 print"[145][145][145][145][145]auf geht's -"
  218. 544 print""
  219. 546 print"[145]jetzt wird gedruckt !"
  220. 548 print"disketten-tasche"
  221. 550 open4,4
  222. 552 print#4,"[213]----------------------------------------------------------------[201]"
  223. 554 for t=1to22
  224. 556 print#4,"[165]    :                                                      :    [167]"
  225. 558 next
  226. 560 print#4,"[202]----[201]......................................................[213]----[203]"
  227. 562 for t=1to28
  228. 564 print#4,"     [221]                                                      [221]"
  229. 566 next
  230. 568 print#4,"     [202]------------------------------------------------------[203]"
  231. 570 close 4
  232. 572 gosub 238
  233. 574 return
  234. 576 rem ---- modul dr huelle+dir+eti --
  235. 578 print"":aw$="                                "
  236. 580 print"";aw$
  237. 582 print"[145]";aw$
  238. 584 print"";aw$
  239. 586 print"[145]";aw$
  240. 588 print"";aw$
  241. 590 print"[145][145][145][145][145]auf geht's -"
  242. 592 print""
  243. 594 print"[145]jetzt wird gedruckt !"
  244. 596 print"disketten-tasche mit aufgedrucktem"
  245. 598 print"directory und aufklebeetikett"
  246. 600 close 1:open 1,4
  247. 602 print#1,chr$(145)
  248. 604 print#1,"[213]----------------------------------------------------------------[201]
  249. 606 [152]1,"fn    :                                                      :    then"
  250. 608 [152]1,"fn    : "[199](14);he$;[199](15);
  251. 610 [152]1,"    disk-nr:";[199](14);nr$;[199](15);" :    then"
  252. 612 [152]1,"fn    : ";:[129] i[178]1 [164] 52:[152]1,"len";:[130]:[152]1," :    then"
  253. 614 [152]1,"fn    : "na$(0);" ";na$(13);" ";na$(26); ":    then"
  254. 616 [152]1,"fn    : "na$(1);" ";na$(14);" ";na$(27); ":    then"
  255. 618 [152]1,"fn    : "na$(2);" ";na$(15);" ";na$(28); ":    then"
  256. 620 [152]1,"fn    : "na$(3);" ";na$(16);" ";na$(29); ":    then"
  257. 622 [152]1,"fn    : "na$(4);" ";na$(17);" ";na$(30); ":    then"
  258. 624 [152]1,"fn    : "na$(5);" ";na$(18);" ";na$(31); ":    then"
  259. 626 [152]1,"fn    : "na$(6);" ";na$(19);" ";na$(32); ":    then"
  260. 628 [152]1,"fn    : "na$(7);" ";na$(20);" ";na$(33); ":    then"
  261. 630 [152]1,"fn    : "na$(8);" ";na$(21);" ";na$(34); ":    then"
  262. 632 [152]1,"fn    : "na$(9);" ";na$(22);" ";na$(35); ":    then"
  263. 634 [152]1,"fn    : "na$(10);" ";na$(23);" ";na$(36); ":    then"
  264. 636 [152]1,"fn    : "na$(11);" ";na$(24);" ";na$(37); ":    then"
  265. 638 [152]1,"fn    : "na$(12);" ";na$(25);" ";na$(38); ":    then"
  266. 640 [152]1,"fn    : ";:[129] i[178]1 [164] 52:[152]1,"len";:[130]:[152]1," :    then"
  267. 642 fr$[178][200](fr$[170]"   ",3)
  268. 644 [152]1,"fn    : stand:"te$"                    "fr$"  blocks free :    then"
  269. 646 [152]1,"fn    :                                                      :    then
  270. 648 print#1,"[165]    :                                                      :    [167]
  271. 650 [152]1,"fn    :                                                      :    then
  272. 652 print#1,"[165]    :                                                      :    [167]
  273. 654 [152]1,"mid$----right$......................................................(NULL)----(NULL)
  274. 656 for t=1to28
  275. 658 print#1,"     [221]                                                      [221]"
  276. 660 next
  277. 662 print#1,"     [202]------------------------------------------------------[203]"
  278. 664 printchr$(10)chr$(10)chr$(10)
  279. 666 gosub 696:
  280. 668 return
  281. 670 rem ---- modul dr etikett ---------
  282. 672 print"":aw$="                                "
  283. 674 print"";aw$
  284. 676 print"[145]";aw$
  285. 678 print"";aw$
  286. 680 print"[145]";aw$
  287. 682 print"";aw$
  288. 684 print"[145][145][145][145][145]auf geht's -"
  289. 686 print""
  290. 688 print"[145]jetzt wird gedruckt !"
  291. 690 print"disketten-etikett"
  292. 692 close 1:open 1,4
  293. 694 print#1,chr$(145)
  294. 696 print#1,chr$(15)"[213][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][178][192][192][201]"chr$(8)
  295. 698 ifnr$=""thennr$="    "
  296. 700 print#1,chr$(15)"[221]"chr$(14)nr$chr$(15)"[221]      [221]"id$"[221]"chr$(8)
  297. 702 print#1,chr$(15)"[171][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][177][192][192][179]"chr$(8)
  298. 704 print#1,chr$(15)"[221] "he$" [221]"chr$(8)
  299. 706 print#1,chr$(15)"[171][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][179]"chr$(8)
  300. 708 co$="[195]ommodore  "+co$
  301. 710 print#1,chr$(15)"[221]  "chr$(17)co$chr$(15)" [221]"chr$(8)
  302. 712 print#1,chr$(15)"[171][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][192][192][192][179]"chr$(8)
  303. 714 mo$=mo$+"'er [205]odus"
  304. 716 print#1,chr$(15)"[221]"fl$"[221]"chr$(17)mo$" [221]"chr$(8)
  305. 718 print#1,chr$(15)"[202][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][192][192][192][203]"chr$(15)
  306. 720 gosub 238
  307. 722 return
  308. 724 rem ---- modul dr dir+et ----------
  309. 726 print"":aw$="                                "
  310. 728 print"";aw$
  311. 730 print"[145]";aw$
  312. 732 print"";aw$
  313. 734 print"[145]";aw$
  314. 736 print"";aw$
  315. 738 print"[145][145][145][145][145]auf geht's -"
  316. 740 print""
  317. 742 print"[145]jetzt wird gedruckt !"
  318. 744 print"directory + aufklebeetikett"
  319. 746 close 1:open 1,4
  320. 748 print#1,chr$(145)
  321. 750 print#1,"   "chr$(14);he$;chr$(15);"    disk-nr:";chr$(14);nr$;chr$(15)
  322. 752 print#1,"   ";:for i=1 to 52:print#1,"[195]";:next:print#1
  323. 754 print#1,"   "na$(0);" ";na$(13);" ";na$(26)
  324. 756 print#1,"   "na$(1);" ";na$(14);" ";na$(27)
  325. 758 print#1,"   "na$(2);" ";na$(15);" ";na$(28)
  326. 760 print#1,"   "na$(3);" ";na$(16);" ";na$(29)
  327. 762 print#1,"   "na$(4);" ";na$(17);" ";na$(30)
  328. 764 print#1,"   "na$(5);" ";na$(18);" ";na$(31)
  329. 766 print#1,"   "na$(6);" ";na$(19);" ";na$(32)
  330. 768 print#1,"   "na$(7);" ";na$(20);" ";na$(33)
  331. 770 print#1,"   "na$(8);" ";na$(21);" ";na$(34)
  332. 772 print#1,"   "na$(9);" ";na$(22);" ";na$(35)
  333. 774 print#1,"   "na$(10);" ";na$(23);" ";na$(36)
  334. 776 print#1,"   "na$(11);" ";na$(24);" ";na$(37)
  335. 778 print#1,"   "na$(12);" ";na$(25);" ";na$(38)
  336. 780 print#1,"   ";:for i=1 to 52:print#1,"[195]";:next:print#1
  337. 782 print#1,"   stand:"te$"                    ";fr$;"  blocks free"
  338. 784 print#1:print#1:close 1
  339. 786 close 1:open 1,4
  340. 788 print#1,chr$(145)
  341. 790 gosub 696
  342. 792 return
  343. 794 rem ---- modul nochmal ------------
  344. 796 print"":aw$="                                "
  345. 798 print"";aw$
  346. 800 print"[145]";aw$
  347. 802 print"";aw$
  348. 804 print"[145]";aw$
  349. 806 print"";aw$
  350. 808 print"[145][145][145][145][145]wollen sie noch mehr drucken ?"
  351. 810 print""
  352. 812 print"[145](j/n)"
  353. 814 getan$:if an$="" then 814
  354. 816 if an$="j" then run 134
  355. 818 if an$="n" then print"hoffentlich sind die ausdrucke"
  356. 820 if an$="n" then print"zu ihrer zufriedenheit aus-"
  357. 822 if an$="n" then print"ausgefallen  !!"
  358. 824 if an$="n" then print"[145]tschuess - "
  359. 826 if an$="n" then print"bis bald !!"
  360. 828 if an$="n" then poke198,0:wait198,1:print"[147]":return
  361.